MacTech 1 to 12/MacTech-vol-1-12.toast/Source/MacTech® Magazine/Volume 02 - 1986/02.08 Aug 86.sit/02.08 Aug 86/pascal/Rascal source/KeyboardSleuth.src

Text File | 1986-05-23 | 12.5 KB | 363 lines | [TEXT/RCMP]

program KeyboardSleuth;
(* Keyboard Sleuth: analyze key mappings
   Stand-alone version written in Rascal
   By Joel West, May 1986, for MacTutor

   Tries to figure out what keyboard is installed
   Uses several approaches:
        Dump and analyze keyboard #
        Check keypad for Mac 512 vs. Mac Plus
        Look at INTL resources to find for country code
        Check for mapping of space key (US vs. Foreign)
   Then allows user to type keys and shows their keycodes and ASCII values
   Dumps all this to screen and to a logfile

   There are two Rascal idiosyncracies that may seem unfamiliar:
        1. Certain reserved entry points (_INIT, _EVENT, _HALT)
           do most of the work.
        2. A few concepts (typing, strings delimiters) are more
           C-like than Pascal-like.
*)

(* Include files and constants *)
(*$U+*)         (* Turn on full Uses *)
    Uses __Windows, __QuickDraw,uToolIntf,uOSIntf,uPackIntf,__PackTraps;

    Link __NoSysCall,__PackTraps;    (* Make small stand-alone application *)

(* This is to Rascal procedure _EVENT what the first parameter
   of GetNextEvent is to other languages
*)
    EventMask 10;    (* mouseDown(2) + keyDown(8) *)


CONST
    Key1Trans = $29E;           (* Low Memory Globals *)
    Key2Trans = $2A2;

    EOL = 13;                   (* end of line file delimiter (RETURN) *)

(********************************* ASCII values **************************)
    Space = $20;                (*   *)

(* The following are Key #10, where US,UK "/" is (key # differs in US)
 *)
    Slash = $2F;                (* /    UK      *)
    Minus = $2D;                (* -    German, Spanish, Swedish *)
    Equals = $3D;               (* =    French  *)
    Ograve = $98;               (* ò    Italian *)
    Eaigu = $8E;                (* é    French Canadian *)
(* The following are Key # 36, where UK "`" (accent grave) is
   Used only to distinguish Spanish from German and Swedish
 *)
    Degree = $A1;               (* °    Spanish/Latin American *)
    Hash = $8A;                 (* #    German   *)
    Apos = $27;                 (* '    Swedish  *)

(********************************* Keycap Numbers **************************)
    USspKey = 49;               (* space bar in US *)
    UKspKey = 52;               (* space bar in UK and other Euro-Classics*)
    UKslKey = 10;               (* / key in UK *)
    UKgrKey = 36;               (* ` (dead) key in UK *)

VAR
    mywindow: WindowPtr;
    logfile: Integer;           (* type BOOLEAN in Pascal *)
    logname: byte[30];

(*************************************BEGIN CODE******************************)
(* Set up a new window *)
Procedure OpenMyWind();
    VAR
        myrect: Rect;
    BEGIN
        GetPort(@mywindow);
        SetRect(myrect,10,40,500,330);
        mywindow := NewWindow(0L, myrect, "Keyboard Sleuth", TRUE,
                              noGrowDocProc, LongInt(-1), TRUE, 0L);
        SetPort(mywindow);
        Move(0,20);             (* skip down a few lines *)
    END;

(* This is just glue for the standard register-based Memory Manager
   call of the same name
*)
Procedure BlockMove(src, dest: PtrB; count: LongInt);
    BEGIN
        regcall (Trap $A02E,src,dest,count)
    END;

(* Open the log file *)
Procedure OpenLog();
    VAR
        stat: integer;
    BEGIN
        BlockMove("KeyBoard Log", logname, 13L);        (* with length byte *)
(* Some terrible kludges are required to support 4-char
   resource types; (see MacTutor, 5/86, page 53
*)
        fcreate(logname, " MACA"+2, " TEXT"+2, 0);  (* MacWrite text-only *)
        fopen(@logfile, logname, 2, 0);
        fErr(@stat);
        IF stat THEN
            logfile := 0                (* file not opened *)
        ELSE
            fSetEOF(logfile, 0L);       (* set EOF to beginning *)
    END;

(* Write a string to the log file and to the screen *)
Procedure PutString(str: PtrB); (* arg is Pascal string *)
    BEGIN
        writestring(str);       (* to the screen *)
        IF logfile THEN
            fPutS(logfile, str);(* to the file *)
    END;

(* Write an integer to the log file and to the screen *)
Procedure PutInt(num: Integer);
  VAR
        buff: byte[10];
  BEGIN
        NumToString(LongInt(num), buff);
        PutString(buff);        (* let it do all the work *)
  END;

(* Write a new line to the log file and to the screen *)
Procedure PutLine();
  BEGIN
        writeln();
        IF logfile THEN
            fPutC(logfile, EOL);(* Disk files are CR-delimited *)
  END;

(* Fetch low memory value indicating the keyboard number *)
Function KbdType(): Integer;
  BEGIN
        KbdType := PtrB($21E)^; (* Just dereference absolute byte ptr *)
  END;

(* Translate key number and modifiers to
   their corresponding ASCII value
*)
Function KeyTrans(keyno,modifies: Integer) : Integer;
(*
   This tries to call the country-specific keycode translator
   that is loaded in location $29E.  It calls the keypad translator
   at Key2Trans for keycodes >= 64.

   Both routines expect the keycode in register d2, and the modifiers
   in the lower bits of register d1; they return an ASCII value in
   register D0
*)
    VAR
        d1,d2,d0,rtnloc: LongInt;
    BEGIN
        IF keyno < 64 THEN      (* main keyboard *)
            rtnloc := PtrL(Key1Trans)^
        ELSE                    (* auxillary keypad *)
          BEGIN
            rtnloc := PtrL(Key2Trans)^;
            keyno := keyno-64;
          END;
        d2 := keyno;
        d1 := (modifies>>9) and 7;
        d0 := 0;
        push(d1);               (* Push variables onto stack *)
        push(d2);
        pop(Reg D2.L);          (* Pop into corresponding registers *)
        pop(Reg D1.L);

(* The following statement calls the routine whose address is stored
   in variable rtnloc, and then sets the return value (register d0)
   into variable "d0"
*)
        RegCall(Call rtnloc, ,,d0);
        KeyTrans := d0;
    END;

(* Show *)
Procedure ShowIntlNation();
    VAR
        country: integer;
        ih: intl0Hndl;
    BEGIN
        ih := intl0Hndl(IUGetIntl(0));          (* get INTL 0 resource *)
        country := (ih^^.intl0Vers) >> 8;       (* country is upper byte *)

        PutString("This Mac is configured for ");

(* There are a number of symbolic constants for these (verUS, verFrance, etc.),
   but if your have the latest update to your development system, you
   probably won't have all 26.  I've hard-coded them for clarity.
*)
       CASE country OF
           0:   PutString("the US or Canada");
           1:   PutString("France");
           2:   PutString("U.K. or Ireland");
           3:   PutString("Deutschland");       (* Germany *)
           4:   PutString("Italia");
           5:   PutString("Nederland");         (* Netherlands *)
           6:   PutString("Belgique ou Luxembourg");
           7:   PutString("Sverige");           (* Sweden *)
           8:   PutString("Españá");            (* Spain *)
           9:   PutString("Danmark");
          10:   PutString("Portugal");
          11:   PutString("Quebec");            (* French Canada *)
          12:   PutString("Norge");             (* Norway *)
          13:   PutString("Yisra’el");
          14:   PutString("Nippon");            (* Japan *)
          15:   PutString("Australia or New Zealand");
          16:   PutString("Arabiyah");
          17:   PutString("Suomi");             (* Finland *)
          18:   PutString("Suisse");            (* French Swiss *)
          19:   PutString("Schweiz");           (* German Swiss *)
          20:   PutString("Ellas");             (* Greece *)
          21:   PutString("Island");            (* Iceland *)
          22:   PutString("Malta");
          23:   PutString("Kypros");            (* Cyprus *)
          24:   PutString("Türkiye");
          25:   PutString("Jugoslavija");
          OTHERWISE
            BEGIN
              PutString("an unknown country, #");
              PutInt(country);
            END;
        END;

        PutString(".");
        PutLine();
        PutLine();
    END;

(* Guess which type of Macintosh keyboard *)
Procedure ShowModel();
    BEGIN
(* Use derived keyboard numbers *)

        PutString("The keyboard type is ");
        PutInt(KbdType());

        CASE KbdType() OF
          11:
            PutString(", which is a Mac Plus keyboard.");
          3:
            PutString(", which is the Classic Mac keyboard.");
          OTHERWISE
            PutString(", which is unknown.");
        END;

        PutLine();
    END;

(* Guess which country keyboard mappings are set for  *)
Procedure GuessKeyNation();
    BEGIN
(* Try mapping of certain keys to figure US vs. non-US keyboard *)
        IF (KeyTrans(USspKey,0) = Space) THEN
            PutString("This is US, Canadian or down under.")
        ELSE
            IF (KeyTrans(UKspKey,0) = Space) THEN
              BEGIN
(* Use UK "/" key to guess at nationality *)
                CASE KeyTrans(UKslKey,0) OF
                    Slash:              (* /    UK      *)
                        PutString("I am British or Dutch.");
                    Ograve:             (* ò    Italian *)
                        PutString("Sono Italiano.");
                    Equals:             (* =    French  *)
                        PutString("Je suis français, suisse ou belge.");
                    Eaigu:              (* é    French Canadian *)
                        PutString("Je suis canadien.");
                    Minus:              (* -    German, Spanish, Swedish  *)
(* Use UK accent grave (dead `) to tell German, Spanish, and Swedish *)
                        CASE KeyTrans(UKgrKey,0) OF
                            Hash:       (* #    German   *)
                                PutString("Ich bin ein Deutscher.");
                            Degree:     (* ç    Spanish  *)
                                PutString("Habla Español.");
                            Apos:       (* '    Swedish   *)
                                PutString("This is Swedish.");
                            otherwise   (* I have no country! *)
                                PutString("¡No tengo un país!");
                        END;
                   OTHERWISE
                        PutString("I am a Mac without a country!");
                END;
              END
          ELSE
              PutString("Neither US nor European, what is it?");
        PutLine();
    END;

(* Rascal calls this routine once on initialization *)
Procedure _INIT();
    BEGIN
        OpenMyWind();           (* display window *)
        OpenLog();              (* log file *)

        ShowIntlNation();       (* Find country code *)
        ShowModel();            (* Examine keyboard type *)

        GuessKeyNation();       (* Look at key mappings *)

        PutLine();
        PutLine();
        PutString("Type keys, or click mouse to quit.");
        PutLine();
    END;


(* Rascal calls this routine for each event posted
   Come here for key down (debug decoding)
   or mouse down (time to quit)
*)
Procedure _EVENT(myevr: EventRecord);
    VAR
        keyc,mods,asc: Integer;
        buff : byte[2];
    BEGIN
        buff[0] := 1;           (* set 1-char Pascal string buffer *)
        SetPort(mywindow);
        CASE myevr.what OF
            mouseDown:
              reqhalt();        (* Calls _HALT implicitly *)
            keyDown:
              BEGIN
(* Isolate keycode and modifiers *)
                keyc := (myevr.message and keyCodeMask)>>8;
                mods := myevr.modifiers;
                PutString("Key #");
                PutInt(keyc);
                IF mods and optionKey THEN
                    PutString(" with Option");
                IF mods and shiftKey THEN
                    PutString(", shifted");
                IF mods and alphaLock THEN
                    PutString(", Caps Locked");
                asc := KeyTrans(keyc,mods);     (* translate to ASCII *)
(* Don't want to print control characters *)
                IF asc >= 32 THEN
                BEGIN
                    PutString(" is ");
                    buff[1] := asc;             (* stuff char in temp string *)
                    PutString(buff);            (* put char *)
                    PutString(" (ascii ");
                    PutInt(asc);
                    PutString(").");
                END;
                PutLine();
              END;
        END;
    END;

(* Called by Rascal when done *)
Procedure _HALT();
    BEGIN
        DisposeWindow(mywindow);
        IF logfile THEN
            fclose(logfile);
(* From here, Rascal automatically exits to the Rascal environment,
   or ExitToShell if a stand-alone application is built
*)
    END;